home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / B-Book Series / (k)b2.d64 / enrol < prev    next >
Text File  |  2007-02-28  |  4KB  |  165 lines

  1. 0010 //OLDHAM'S GRAMMAR SCHOOL//
  2. 0020 //PROGRAM TO ADMINISTER PUPILS' MARKS//
  3. 0030 //WRITTEN BY CHRIS BORGE IN CBM COMAL-80//
  4. 0040 //THIS VERSION: JAN. 1981//
  5. 0050 //THIS PART: TO ENROL PUPILS//
  6. 0060 //
  7. 0070 MAX:=8
  8. 0080 DIM NAME$(MAX) OF 20, ANSW$ OF 10
  9. 0090 DIM THISNAME$ OF 20
  10. 0100 DIM MARK(MAX,3), SUBJ$(3) OF 11, KEY'(MAX)
  11. 0110 DIM SPACES$ OF 39
  12. 0120 //*
  13. 0130 SUBJ$(1):="ENGLISH"
  14. 0140 SUBJ$(2):="MATHEMATICS"
  15. 0150 SUBJ$(3):="FRENCH"
  16. 0160 SPACES$(1:39):=""
  17. 0190 //
  18. 0200 STARTSYSTEM
  19. 0210 //
  20. 0220 //* MAINLINES *//
  21. 0230 REPEAT 
  22. 0240 PRINT CHR$(147) //CLEAR SCREEN
  23. 0250 FIELD(8,15)
  24. 0260 PRINT "1=ENROLL"
  25. 0270 PRINT "2=LIST"
  26. 0280 PRINT "3=STOP"
  27. 0290 PRINT 
  28. 0300 INPUT "> ": JOBCODE
  29. 0310 IF JOBCODE=1 THEN ENROL
  30. 0320 IF JOBCODE=2 THEN PRINTOUT
  31. 0330 IF JOBCODE=3 THEN STOPSYSTEM
  32. 0340 UNTIL FALSE
  33. 0350 //
  34. 0360 PROC ENROL 
  35. 0370 PRINT CHR$(147) //CLEAR//
  36. 0380 FIELD(8,20)
  37. 0390 INPUT "NEW CLASS (YES/RETURN): ": ANSW$
  38. 0400 IF ANSW$="YES" THEN
  39. 0410 NEWCLASS
  40. 0420 ELSE 
  41. 0430 TAKEIN("PUPILNO")
  42. 0440 WHILE MORE DO
  43. 0450 IF NAME$(PUPILNO)<>"" THEN
  44. 0460 ERROR(3)
  45. 0470 ELSE 
  46. 0480 TAKEIN("PUPILNAME")
  47. 0490 NAME$(PUPILNO):=THISNAME$
  48. 0500 FOR SUBJNO:=1 TO 3 DO MARK(PUPILNO,SUBJNO):=-1
  49. 0510 ENDIF 
  50. 0520 TAKEIN("PUPILNO")
  51. 0530 ENDWHILE 
  52. 0540 ENDIF 
  53. 0550 ENDPROC ENROL
  54. 0560 //
  55. 0570 PROC NEWCLASS 
  56. 0580 TAKEIN("CLASS")
  57. 0590 INITCLASS
  58. 0600 PRINT CHR$(147) //CLEAR SCREEN//
  59. 0610 PUPILNO:=1
  60. 0620 TAKEIN("PUPILNAME")
  61. 0630 WHILE NOT (THISNAME$="" OR PUPILNO=MAX) DO
  62. 0640 NAME$(PUPILNO):=THISNAME$
  63. 0650 PUPILNO:=PUPILNO+1
  64. 0660 TAKEIN("PUPILNAME")
  65. 0670 ENDWHILE 
  66. 0680 PRINT CHR$(147)
  67. 0690 ENDPROC NEWCLASS
  68. 0700 //
  69. 0710 PROC INITCLASS 
  70. 0720 FOR PUPILNO:=1 TO MAX DO
  71. 0730 NAME$(PUPILNO):=""
  72. 0740 FOR SUBJNO:=1 TO 3 DO MARK(PUPILNO,SUBJNO):=-1
  73. 0750 ENDFOR PUPILNO
  74. 0760 ENDPROC INITCLASS
  75. 0770 //
  76. 0780 PROC TAKEIN(MATTER$) 
  77. 0790 REPEAT 
  78. 0800 FIELD(8,10)
  79. 0810 CASE MATTER$ OF
  80. 0820 WHEN "PUPILNO"
  81. 0830 INPUT "PUPIL NUMBER (0 TO STOP): ": PUPILNO
  82. 0840 WHEN "PUPILNAME"
  83. 0850 PRINT "PUPIL NUMBER ",PUPILNO,
  84. 0860 INPUT " : ": THISNAME$
  85. 0870 WHEN "CLASS"
  86. 0880 INPUT "CLASS (8,9,10): ": CLASS
  87. 0890 ENDCASE 
  88. 0900 CONTROL
  89. 0910 UNTIL OK
  90. 0920 PRINT CHR$(147) //CLEAR SCREEN
  91. 0930 ENDPROC TAKEIN
  92. 0940 //
  93. 0950 PROC CONTROL 
  94. 0960 CASE MATTER$ OF
  95. 0970 WHEN "PUPILNO"
  96. 0980 OK:=(0<=PUPILNO AND PUPILNO<=MAX)
  97. 0990 MORE:=(PUPILNO>0)
  98. 1000 WHEN "PUPILNAME"
  99. 1010 OK:=TRUE //NO TEST//
  100. 1020 WHEN "CLASS"
  101. 1030 OK:=(CLASS=8)
  102. 1040 LACKING:=(CLASS=9 OR CLASS=10)
  103. 1050 ENDCASE 
  104. 1060 IF NOT OK THEN ERROR(10)
  105. 1070 ENDPROC CONTROL
  106. 1080 //
  107. 1090 PROC ERROR(NO) 
  108. 1100 FIELD(1,3)
  109. 1110 PRINT "ERROR!"
  110. 1120 //
  111. 1130 //NOT FINISHED//
  112. 1140 //
  113. 1150 ENDPROC ERROR
  114. 1160 //
  115. 1170 //
  116. 1180 PROC FIELD(L1,L2) 
  117. 1190 SCREEN(L1,1)
  118. 1200 FOR I:=1 TO L2-L1+1 DO PRINT SPACES$
  119. 1210 SCREEN(L1,1)
  120. 1220 PRINT 
  121. 1230 ENDPROC FIELD
  122. 1240 //
  123. 1250 PROC SCREEN(ROW,COL) CLOSED
  124. 1260 PRINT CHR$(19) //HOME
  125. 1270 FOR I:=1 TO ROW DO PRINT  //DOWN
  126. 1275 FOR I:=1 TO COL-1 DO PRINT CHR$(29), //RIGHT
  127. 1280 ENDPROC SCREEN
  128. 1290 //
  129. 1300 PROC STARTSYSTEM 
  130. 1310 OPEN FILE 2,"MARKBOOKS",READ
  131. 1320 FOR PUPILNO:=1 TO MAX DO
  132. 1330 READ FILE 2: NAME$(PUPILNO)
  133. 1340 FOR SUBJNO:=1 TO 3 DO READ FILE 2: MARK(PUPILNO,SUBJNO)
  134. 1350 ENDFOR PUPILNO
  135. 1360 CLOSE
  136. 1370 ENDPROC STARTSYSTEM
  137. 1380 //
  138. 1390 PROC STOPSYSTEM 
  139. 1400 OPEN FILE 2,"@0:MARKBOOKS",WRITE
  140. 1410 FOR PUPILNO:=1 TO MAX DO
  141. 1420 WRITE FILE 2: NAME$(PUPILNO)
  142. 1430 FOR SUBJNO:=1 TO 3 DO WRITE FILE 2: MARK(PUPILNO,SUBJNO)
  143. 1440 ENDFOR PUPILNO
  144. 1450 CLOSE
  145. 1460 STOP 
  146. 1470 ENDPROC STOPSYSTEM
  147. 1480 //
  148. 1490 PROC PRINTOUT 
  149. 1500 PRINT CHR$(147) //CLEAR
  150. 1510 FOR PUPILNO:=1 TO MAX DO
  151. 1520 FIELD(8,9)
  152. 1530 IF NAME$(PUPILNO)<>"" THEN
  153. 1540 THISNAME$:=NAME$(PUPILNO)
  154. 1550 PRINT "STUDENT NUMBER ",PUPILNO,", ",THISNAME$
  155. 1560 PRINT "HAS ACHIEVED THE FOLLOWING RESULTS:"
  156. 1570 PRINT 
  157. 1580 FOR SUBJNO:=1 TO 3 DO
  158. 1590 PRINT SUBJ$(SUBJNO),": ",TAB(25),MARK(PUPILNO,SUBJNO)
  159. 1600 ENDFOR SUBJNO
  160. 1610 PRINT 
  161. 1620 INPUT "PRESS RETURN-KEY: ": ANSW$
  162. 1630 ENDIF 
  163. 1640 ENDFOR PUPILNO
  164. 1650 ENDPROC PRINTOUT
  165.